En la base de datos relacionada, se encuentra el “Registro de Eventos Naturales o Antrópicos no Intencionales”ocurridos durante el año 2019, que fueron reportados a la UNGRD (Unidad Nacional para la Gestión del Riesgo de Desastres) con su respectiva afectación y atención prestada a cada uno. https://www.datos.gov.co/Ambiente-y-Desarrollo-Sostenible/Emergencias-UNGRD-2019/4fd8-ptcr (BaseExcelDepurada)
Se estima el tamaño de la muestra usando la fórmuala definida por la máxima varibilidad de los parametros p y q ( se asumen p=q=0.5). Como resultado se obtiene una muestra de tamaño n= 757 observaciones . Y se define un nuevo dataframe nombrado: muestra_inc , q contiene las observaciones de la muestra solicitada, adicionalmente fue necesario en el proceso de limpieza se quitaros 2 registros , un dato que corresponde a Perú y un registro vacio.
N = nrow(Incendios) ## N corresponde a la población total del estudio que son el total de registros
z = qnorm(0.035, mean= 0, sd = 1, lower.tail = TRUE)# Se defini el valor Z a un nivel de significancia α=0,07
d = 0.03 # Corresponde al error del 3% asumido por el investigador
n = z*z*0.5*0.5/(d*d+(z*z*0.5*0.5)/N) # Tamaño de la muestra
n = ceiling(n)
set.seed(3564)
muestra_inc <- Incendios [ sample (N, size = n ),]
#Se genera un nuevo dataframe con las observaciones de la muestra
MediaH=mean(muestra_inc$HERIDOS)
MediaF=mean(muestra_inc$FALLECIDOS)
#Estimaciones
VarH=var(muestra_inc$HERIDOS)
VarEstim=(1-n/N)*VarH/n
EE=sqrt(VarEstim)
CV=(EE/MediaH)*100
valort=qt(c(0.025),df=(757-1),lower.tail = FALSE)# Valor t a un nivel de significancia de 0.025, que equivale a un nivel de confianza del 95%.
Lsup=MediaH+(valort*EE) # Cálculo del límite superior de intervalo de confianza
Linf=MediaH-(valort*EE) # Cálculo del límite inferior de intervalo de confianza
resumenMediaH1 <- data.frame(n ,MediaH,VarEstim,EE,Linf,Lsup,CV)
resumenMediaH1
## n MediaH VarEstim EE Linf Lsup CV
## 1 757 0.3949802 0.004380507 0.0661854 0.2650512 0.5249092 16.75664
EstimTot=N*MediaF
EstimTot
## [1] 574.148
##
VarF=var(muestra_inc$FALLECIDOS)
VarEstimF=(1-757/4435)*VarF/757
EEf=sqrt(VarEstimF)
CVf=(EEf/MediaF)*100
VarEstimTOT=(N^2)*VarEstimF
EETot=sqrt(VarEstimTOT)
valortF=qt(c(0.025),df=(757-1),lower.tail = FALSE)# Valor t a un nivel de significancia de 0.025, que equivale a un nivel de confianza del 95%.
LsupTotF=EstimTot+(valortF*EETot) # Cálculo del límite superior de intervalo de confianza
LinfTotF=EstimTot-(valortF*EETot) # Cálculo del límite inferior de intervalo de confianza
CVTot=(EETot/EstimTot)*100
resumenTotF <- data.frame(n ,EstimTot,VarEstimTOT,EETot,LinfTotF,LsupTotF,CVTot)
resumenTotF
## n EstimTot VarEstimTOT EETot LinfTotF LsupTotF CVTot
## 1 757 574.148 33271.7 182.4053 216.0668 932.2291 31.76974
resumenTotF
## n EstimTot VarEstimTOT EETot LinfTotF LsupTotF CVTot
## 1 757 574.148 33271.7 182.4053 216.0668 932.2291 31.76974
## Cartografía
sp_df <- readOGR(dsn = "MGN2021_DPTO_POLITICO", layer = "MGN_DPTO_POLITICO")
## Warning in OGRSpatialRef(dsn, layer, morphFromESRI = morphFromESRI, dumpSRS =
## dumpSRS, : Discarded datum Marco_Geocentrico_Nacional_de_Referencia in Proj4
## definition: +proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs
## OGR data source with driver: ESRI Shapefile
## Source: "C:\Users\alexg\Documents\GitHub\ProyectoEstadistica\ProyectoEstadistica\TallerMuestreo\MGN2021_DPTO_POLITICO", layer: "MGN_DPTO_POLITICO"
## with 33 features
## It has 9 fields
#head(sp_df)
#fix(sp_df)
#as.data.frame(sp_df)
DPTO_SH="MGN2021_DPTO_POLITICO/MGN_DPTO_POLITICO.shp"
DPTO_SH2 <- st_read(DPTO_SH)
## Reading layer `MGN_DPTO_POLITICO' from data source
## `C:\Users\alexg\Documents\GitHub\ProyectoEstadistica\ProyectoEstadistica\TallerMuestreo\MGN2021_DPTO_POLITICO\MGN_DPTO_POLITICO.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 33 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -81.73562 ymin: -4.229406 xmax: -66.84722 ymax: 13.39473
## Geodetic CRS: MAGNA-SIRGAS
HeridosDepto <- muestra_inc %>%
group_by(DEPARTAMENTO) %>%
summarise(promedioH = mean(HERIDOS),COD_DANE)
## `summarise()` has grouped output by 'DEPARTAMENTO'. You can override using the
## `.groups` argument.
HeridosDepto$promedioH<-round(HeridosDepto$promedioH,2)
# Para visualizar la base resumida
ResumenH=as.data.frame(HeridosDepto)
#ResumenH
Etiquetas=unite(ResumenH, Etiqueta,c(1,2), sep = ": ", remove = TRUE)
Etiquetas=Etiquetas[,1]
#Etiquetas
Resumen3=cbind(ResumenH, Etiquetas )
#Resumen3
DPTO_SH2
## Simple feature collection with 33 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -81.73562 ymin: -4.229406 xmax: -66.84722 ymax: 13.39473
## Geodetic CRS: MAGNA-SIRGAS
## First 10 features:
## DPTO_CCDGO DPTO_CNMBR DPTO_ANO_C DPTO_ACT_A
## 1 05 ANTIOQUIA 1886 Constitucion Politica de 1886
## 2 08 ATLÁNTICO 1910 Ley 21 de 1910
## 3 11 BOGOTÁ, D.C. 1538 Constitucion Politica de 1886
## 4 13 BOLÍVAR 1886 Constitucion Politica de 1886
## 5 15 BOYACÁ 1886 Constitucion Politica de 1886
## 6 17 CALDAS 1905 11 de Abril de 1905
## 7 18 CAQUETÁ 1981 Ley 78 del 29 de Diciembre de 1981
## 8 19 CAUCA 1857 15 de junio de 1857
## 9 20 CESAR 1967 Ley 25 21 de junio de 1967
## 10 23 CÓRDOBA 1951 Ley 9 del 18 de Diciembre de 1951
## DPTO_NAREA DPTO_CSMBL DPTO_VGNC Shape_Leng Shape_Area
## 1 62808.630 3 2021 21.492374 5.1352363
## 2 3314.447 3 2021 2.573162 0.2738225
## 3 1622.853 3 2021 3.765324 0.1322079
## 4 26719.968 3 2021 16.233072 2.1956393
## 5 23138.048 3 2021 15.906491 1.8883908
## 6 7425.246 3 2021 6.663759 0.6054998
## 7 92831.284 3 2021 21.218741 7.5402411
## 8 31242.803 3 2021 13.955090 2.5344101
## 9 22565.307 3 2021 12.578459 1.8582044
## 10 25086.221 3 2021 9.725656 2.0575064
## geometry
## 1 MULTIPOLYGON (((-76.41355 8...
## 2 MULTIPOLYGON (((-74.84946 1...
## 3 MULTIPOLYGON (((-74.07059 4...
## 4 MULTIPOLYGON (((-76.17318 9...
## 5 MULTIPOLYGON (((-72.17368 7...
## 6 MULTIPOLYGON (((-74.67154 5...
## 7 MULTIPOLYGON (((-74.79916 2...
## 8 MULTIPOLYGON (((-76.45922 3...
## 9 MULTIPOLYGON (((-73.45335 1...
## 10 MULTIPOLYGON (((-75.88119 9...
DPTO_JOIN <- geo_join(DPTO_SH2, Resumen3,"DPTO_CCDGO", "COD_DANE")
## Warning: We recommend using the dplyr::*_join() family of functions instead.
## Warning: `group_by_()` was deprecated in dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
#DPTO_JOIN = as.data.frame(DPTO_JOIN)
#DPTO_JOIN
pal <- colorNumeric( palette = "RdYlBu", domain=DPTO_JOIN$promedioH) #palette = "YlGnBu" "RdBu" "RdYlBu" "Spectral" "Paired" "PuRd" "RdYlGn"
popup_sb <- paste0("Promedio de Heridos: ", as.character(DPTO_JOIN$promedioH))
leaflet(sp_df) %>%
addProviderTiles("CartoDB.Positron") %>%
#setView(-98.483330, 38.712046, zoom = 4) %>%
addPolygons(data = DPTO_JOIN ,
fillColor = ~pal(DPTO_JOIN$promedioH),
opacity = 1,
color = "black",
dashArray = "3",fillOpacity = 0.9,
highlight = highlightOptions(
weight = 1,
color = "#666",
dashArray = "",
fillOpacity = 1,
bringToFront = TRUE),
label = DPTO_JOIN$Etiquetas,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))%>%
addLegend(pal = pal, values =DPTO_JOIN$promedioH, opacity = 0.7, title = NULL,
position = "bottomright")
## Warning: sf layer has inconsistent datum (+proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs).
## Need '+proj=longlat +datum=WGS84'